home *** CD-ROM | disk | FTP | other *** search
/ Personal Computer World 2005 October / PCWOCT05.iso / Software / FromTheMag / The GIMP 2.2.8 / gimp-2.2.8-i586-setup.exe / {app} / share / gimp / 2.0 / scripts / text-circle.scm < prev    next >
Encoding:
GIMP Script-Fu Script  |  2005-06-30  |  5.2 KB  |  153 lines
  1. ;; text-circle.scm -- a script for The GIMP
  2. ;; Author: Shuji Narazaki <narazaki@gimp.org>
  3. ;; Time-stamp: <1998/11/25 13:26:51 narazaki@gimp.org>
  4. ;; Version 2.5
  5. ;; Thanks:
  6. ;;   jseymour@jimsun.LinxNet.com (Jim Seymour)
  7. ;;   Sven Neumann <neumanns@uni-duesseldorf.de>
  8.  
  9.  
  10. (if (not (symbol-bound? 'script-fu-text-circle-debug? (the-environment)))
  11.     (define script-fu-text-circle-debug? #f))
  12.  
  13. (define (script-fu-text-circle text radius start-angle fill-angle
  14.                    font-size antialias font-name)
  15.   ;;(set! script-fu-text-circle-debug? #t)
  16.   (define modulo fmod)            ; in R4RS way
  17.   (define (wrap-string str) (string-append "\"" str "\""))
  18.   (define (white-space-string? str)
  19.     (or (equal? " " str) (equal? "    " str)))
  20.   (let* ((drawable-size (* 2.0 (+ radius (* 2 font-size))))
  21.      (img (car (gimp-image-new drawable-size drawable-size RGB)))
  22.      (BG-layer (car (gimp-layer-new img drawable-size drawable-size
  23.                     RGBA-IMAGE "background" 100 NORMAL-MODE)))
  24.      (merged-layer #f)
  25.      (char-num (string-length text))
  26.      (radian-step 0)
  27.      (rad-90 (/ *pi* 2))
  28.      (center-x (/ drawable-size 2))
  29.      (center-y center-x)
  30.      (font-infos (gimp-text-get-extents-fontname "lAgy" font-size
  31.                              PIXELS font-name))
  32.      (desc (nth 3 font-infos))
  33.      (angle-list #f)
  34.      (letter "")
  35.      (new-layer #f)
  36.      (index 0))
  37.     (gimp-image-undo-disable img)
  38.     (gimp-image-add-layer img BG-layer 0)
  39.     (gimp-edit-fill BG-layer BACKGROUND-FILL)
  40.     ;; change units
  41.     (set! start-angle-rad (* (/ (modulo start-angle 360) 360) 2 *pi*))
  42.     (set! fill-angle-rad (* (/ fill-angle 360) 2 *pi*))
  43.     (set! radian-step (/ fill-angle-rad char-num))
  44.  
  45.     ;; make width-list
  46.     ;;  In a situation,
  47.     ;; (car (gimp-drawable-width (car (gimp-text ...)))
  48.     ;; != (car (gimp-text-get_extent ...))
  49.     ;; Thus, I changed to gimp-text from gimp-text-get-extent at 2.2 !!
  50.     (let ((temp-list '())
  51.       (temp-str #f)
  52.       (temp-layer #f)
  53.       (scale 0)
  54.       (temp #f))
  55.       (set! index 0)
  56.       (while (< index char-num)
  57.     (set! temp-str (substring text index (+ index 1)))
  58.     (if (white-space-string? temp-str)
  59.         (set! temp-str "x"))
  60.     (set! temp-layer (car (gimp-text-fontname img -1 0 0
  61.                           temp-str
  62.                           1 antialias
  63.                           font-size PIXELS
  64.                           font-name)))
  65.     (set! temp-list (cons (car (gimp-drawable-width temp-layer)) temp-list))
  66.     (gimp-image-remove-layer img temp-layer)
  67.     (set! index (+ index 1)))
  68.       (set! angle-list (nreverse temp-list))
  69.       (set! temp 0)
  70.       (set! angle-list
  71.         (mapcar (lambda (angle)
  72.               (let ((tmp temp))
  73.             (set! temp (+ angle temp))
  74.             (+ tmp (/ angle 2))))
  75.             angle-list))
  76.       (set! scale (/ fill-angle-rad temp))
  77.       (set! angle-list (mapcar (lambda (angle) (* scale angle)) angle-list)))
  78.     (set! index 0)
  79.     (while (< index char-num)
  80.       (set! letter (substring text index (+ index 1)))
  81.       (if (not (white-space-string? letter))
  82.       ;; Running gimp-text with " " causes an error!
  83.       (let* ((new-layer
  84.           (car (gimp-text-fontname img -1 0 0
  85.                        letter
  86.                        1 antialias
  87.                        font-size PIXELS
  88.                        font-name)))
  89.          (width (car (gimp-drawable-width new-layer)))
  90.          (height (car (gimp-drawable-height new-layer)))
  91.          (rotate-radius (- (/ height 2) desc))
  92.          (angle (+ start-angle-rad (- (nth index angle-list) rad-90))))
  93.  
  94.         (gimp-layer-resize new-layer width height 0 0)
  95.         (set! width (car (gimp-drawable-width new-layer)))
  96.         (if (not script-fu-text-circle-debug?)
  97.         (begin
  98.           (gimp-drawable-transform-rotate-default new-layer
  99.                               ((if (< 0 fill-angle-rad)
  100.                                    + -) angle rad-90)
  101.                               TRUE 0 0
  102.                               TRUE FALSE)
  103.           (gimp-layer-translate new-layer
  104.                     (+ center-x
  105.                        (* radius (cos angle))
  106.                        (* rotate-radius
  107.                           (cos (if (< 0 fill-angle-rad)
  108.                                angle
  109.                                (+ angle *pi*))))
  110.                        (- (/ width 2)))
  111.                     (+ center-y
  112.                        (* radius (sin angle))
  113.                        (* rotate-radius
  114.                           (sin (if (< 0 fill-angle-rad)
  115.                                angle
  116.                                (+ angle *pi*))))
  117.                        (- (/ height 2))))
  118.                   
  119.                   ))))
  120.       (set! index (+ index 1)))
  121.     (gimp-drawable-set-visible BG-layer 0)
  122.     (if (not script-fu-text-circle-debug?)
  123.     (begin
  124.       (set! merged-layer
  125.         (car (gimp-image-merge-visible-layers img CLIP-TO-IMAGE)))
  126.       (gimp-drawable-set-name merged-layer
  127.                    (if (< (length text) 16)
  128.                    (wrap-string text)
  129.                    "Text Circle"))))
  130.     (gimp-drawable-set-visible BG-layer 1)
  131.     (gimp-image-undo-enable img)
  132.     (gimp-image-clean-all img)
  133.     (gimp-display-new img)
  134.     (gimp-displays-flush)))
  135.  
  136. (script-fu-register "script-fu-text-circle"
  137.             _"Text Circle..."
  138.             "Render the specified text along the perimeter of a circle"
  139.             "Shuji Narazaki <narazaki@gimp.org>"
  140.             "Shuji Narazaki"
  141.             "1997-1998"
  142.             ""
  143.             SF-STRING     _"Text"               "The GNU Image Manipulation Program Version 2.2 "
  144.             SF-ADJUSTMENT _"Radius"             '(80 1 8000 1 1 0 1)
  145.             SF-ADJUSTMENT _"Start angle"        '(0 -180 180 1 1 0 1)
  146.             SF-ADJUSTMENT _"Fill angle"         '(360 -360 360 1 1 0 1)
  147.             SF-ADJUSTMENT _"Font size (pixels)" '(18 1 1000 1 1 0 1)
  148.             SF-TOGGLE     _"Antialias"          TRUE
  149.             SF-FONT       _"Font"               "Sans")
  150.  
  151. (script-fu-menu-register "script-fu-text-circle"
  152.              _"<Toolbox>/Xtns/Script-Fu/Logos")
  153.